home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol146 / xldmem.c < prev    next >
Encoding:
C/C++ Source or Header  |  1986-12-16  |  7.4 KB  |  366 lines
  1. /* xldmem - xlisp dynamic memory management routines */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* useful definitions */
  9. #define ALLOCSIZE (sizeof(struct segment) + (anodes-1) * sizeof(NODE))
  10.  
  11. /* external variables */
  12. extern NODE *oblist,*keylist;
  13. extern NODE *xlstack;
  14. extern NODE *xlenv;
  15. extern long total;
  16. extern int anodes,nnodes,nsegs,nfree,gccalls;
  17. extern struct segment *segs;
  18. extern NODE *fnodes;
  19. extern char buf[];
  20.  
  21. /* external procedures */
  22. extern char *malloc();
  23. extern char *calloc();
  24.  
  25. /* newnode - allocate a new node */
  26. NODE *newnode(type)
  27.   int type;
  28. {
  29.     NODE *nnode;
  30.  
  31.     /* get a free node */
  32.     if ((nnode = fnodes) == NIL) {
  33.     gc();
  34.     if ((nnode = fnodes) == NIL)
  35.         xlabort("insufficient node space");
  36.     }
  37.  
  38.     /* unlink the node from the free list */
  39.     fnodes = cdr(nnode);
  40.     nfree -= 1;
  41.  
  42.     /* initialize the new node */
  43.     nnode->n_type = type;
  44.     rplacd(nnode,NIL);
  45.  
  46.     /* return the new node */
  47.     return (nnode);
  48. }
  49.  
  50. /* cvfixnum - convert an integer to a fixnum node */
  51. NODE *cvfixnum(n)
  52.   FIXNUM n;
  53. {
  54.     NODE *val;
  55.     val = newnode(INT);
  56.     val->n_int = n;
  57.     return (val);
  58. }
  59.  
  60. /* cvflonum - convert a floating point number to a flonum node */
  61. NODE *cvflonum(n)
  62.   FLONUM n;
  63. {
  64.     NODE *val;
  65.     val = newnode(FLOAT);
  66.     val->n_float = n;
  67.     return (val);
  68. }
  69.  
  70. /* stralloc - allocate memory for a string adding a byte for the terminator */
  71. char *stralloc(size)
  72.   int size;
  73. {
  74.     char *sptr;
  75.  
  76.     /* allocate memory for the string copy */
  77.     if ((sptr = malloc(size+1)) == NULL) {
  78.     gc();
  79.     if ((sptr = malloc(size+1)) == NULL)
  80.         xlfail("insufficient string space");
  81.     }
  82.     total += (long) (size+1);
  83.  
  84.     /* return the new string memory */
  85.     return (sptr);
  86. }
  87.  
  88. /* strsave - generate a dynamic copy of a string */
  89. char *strsave(str)
  90.   char *str;
  91. {
  92.     char *sptr;
  93.  
  94.     /* create a new string */
  95.     sptr = stralloc(strlen(str));
  96.     strcpy(sptr,str);
  97.  
  98.     /* return the new string */
  99.     return (sptr);
  100. }
  101.  
  102. /* strfree - free string memory */
  103. strfree(str)
  104.   char *str;
  105. {
  106.     total -= (long) (strlen(str)+1);
  107.     free(str);
  108. }
  109.  
  110. /* gc - garbage collect */
  111. gc()
  112. {
  113.     NODE *p;
  114.  
  115.     /* mark all accessible nodes */
  116.     mark(oblist); mark(keylist);
  117.     mark(xlenv);
  118.  
  119.     /* mark the evaluation stack */
  120.     for (p = xlstack; p; p = cdr(p))
  121.     mark(car(p));
  122.  
  123.     /* sweep memory collecting all unmarked nodes */
  124.     sweep();
  125.  
  126.     /* if there's still nothing available, allocate more memory */
  127.     if (fnodes == NIL)
  128.     addseg();
  129.  
  130.     /* count the gc call */
  131.     gccalls++;
  132. }
  133.  
  134. /* mark - mark all accessible nodes */
  135. LOCAL mark(ptr)
  136.   NODE *ptr;
  137. {
  138.     NODE *this,*prev,*tmp;
  139.  
  140.     /* just return on nil */
  141.     if (ptr == NIL)
  142.     return;
  143.  
  144.     /* initialize */
  145.     prev = NIL;
  146.     this = ptr;
  147.  
  148.     /* mark this list */
  149.     while (TRUE) {
  150.  
  151.     /* descend as far as we can */
  152.     while (TRUE) {
  153.  
  154.         /* check for this node being marked */
  155.         if (this->n_flags & MARK)
  156.         break;
  157.  
  158.         /* mark it and its descendants */
  159.         else {
  160.  
  161.         /* mark the node */
  162.         this->n_flags |= MARK;
  163.  
  164.         /* follow the left sublist if there is one */
  165.         if (livecar(this)) {
  166.             this->n_flags |= LEFT;
  167.             tmp = prev;
  168.             prev = this;
  169.             this = car(prev);
  170.             rplaca(prev,tmp);
  171.         }
  172.  
  173.         /* otherwise, follow the right sublist if there is one */
  174.         else if (livecdr(this)) {
  175.             this->n_flags &= ~LEFT;
  176.             tmp = prev;
  177.             prev = this;
  178.             this = cdr(prev);
  179.             rplacd(prev,tmp);
  180.         }
  181.         else
  182.             break;
  183.         }
  184.     }
  185.  
  186.     /* backup to a point where we can continue descending */
  187.     while (TRUE) {
  188.  
  189.         /* check for termination condition */
  190.         if (prev == NIL)
  191.         return;
  192.  
  193.         /* check for coming from the left side */
  194.         if (prev->n_flags & LEFT)
  195.         if (livecdr(prev)) {
  196.             prev->n_flags &= ~LEFT;
  197.             tmp = car(prev);
  198.             rplaca(prev,this);
  199.             this = cdr(prev);
  200.             rplacd(prev,tmp);
  201.             break;
  202.         }
  203.         else {
  204.             tmp = prev;
  205.             prev = car(tmp);
  206.             rplaca(tmp,this);
  207.             this = tmp;
  208.         }
  209.  
  210.         /* otherwise, came from the right side */
  211.         else {
  212.         tmp = prev;
  213.         prev = cdr(tmp);
  214.         rplacd(tmp,this);
  215.         this = tmp;
  216.         }
  217.     }
  218.     }
  219. }
  220.  
  221. /* sweep - sweep all unmarked nodes and add them to the free list */
  222. LOCAL sweep()
  223. {
  224.     struct segment *seg;
  225.     NODE *p;
  226.     int n;
  227.  
  228.     /* empty the free list */
  229.     fnodes = NIL;
  230.     nfree = 0;
  231.  
  232.     /* add all unmarked nodes */
  233.     for (seg = segs; seg != NULL; seg = seg->sg_next) {
  234.     p = &seg->sg_nodes[0];
  235.     for (n = seg->sg_size; n--; p++)
  236.         if (!(p->n_flags & MARK)) {
  237.         switch (ntype(p)) {
  238.         case STR:
  239.             if (p->n_strtype == DYNAMIC && p->n_str != NULL)
  240.                 strfree(p->n_str);
  241.             break;
  242.         case FPTR:
  243.             if (p->n_fp)
  244.                 fclose(p->n_fp);
  245.             break;
  246.         }
  247.         p->n_type = FREE;
  248.         p->n_flags = 0;
  249.         rplaca(p,NIL);
  250.         rplacd(p,fnodes);
  251.         fnodes = p;
  252.         nfree++;
  253.         }
  254.         else
  255.         p->n_flags &= ~(MARK | LEFT);
  256.     }
  257. }
  258.  
  259. /* addseg - add a segment to the available memory */
  260. int addseg()
  261. {
  262.     struct segment *newseg;
  263.     NODE *p;
  264.     int n;
  265.  
  266.     /* check for zero allocation */
  267.     if (anodes == 0)
  268.     return (FALSE);
  269.  
  270.     /* allocate a new segment */
  271.     if ((newseg = (struct segment *) calloc(1,ALLOCSIZE)) != NULL) {
  272.  
  273.     /* initialize the new segment */
  274.     newseg->sg_size = anodes;
  275.     newseg->sg_next = segs;
  276.     segs = newseg;
  277.  
  278.     /* add each new node to the free list */
  279.     p = &newseg->sg_nodes[0];
  280.     for (n = anodes; n--; ) {
  281.         rplacd(p,fnodes);
  282.         fnodes = p++;
  283.     }
  284.  
  285.     /* update the statistics */
  286.     total += (long) ALLOCSIZE;
  287.     nnodes += anodes;
  288.     nfree += anodes;
  289.     nsegs++;
  290.  
  291.     /* return successfully */
  292.     return (TRUE);
  293.     }
  294.     else
  295.     return (FALSE);
  296. }
  297.  
  298. /* livecar - do we need to follow the car? */
  299. LOCAL int livecar(n)
  300.   NODE *n;
  301. {
  302.     switch (ntype(n)) {
  303.     case SUBR:
  304.     case FSUBR:
  305.     case INT:
  306.     case FLOAT:
  307.     case STR:
  308.     case FPTR:
  309.         return (FALSE);
  310.     case SYM:
  311.     case LIST:
  312.     case OBJ:
  313.         return (car(n) != NIL);
  314.     default:
  315.         printf("bad node type (%d) found during left scan\n",ntype(n));
  316.         exit();
  317.     }
  318. }
  319.  
  320. /* livecdr - do we need to follow the cdr? */
  321. LOCAL int livecdr(n)
  322.   NODE *n;
  323. {
  324.     switch (ntype(n)) {
  325.     case SUBR:
  326.     case FSUBR:
  327.     case INT:
  328.     case FLOAT:
  329.     case STR:
  330.     case FPTR:
  331.         return (FALSE);
  332.     case SYM:
  333.     case LIST:
  334.     case OBJ:
  335.         return (cdr(n) != NIL);
  336.     default:
  337.         printf("bad node type (%d) found during right scan\n",ntype(n));
  338.         exit();
  339.     }
  340. }
  341.  
  342. /* stats - print memory statistics */
  343. stats()
  344. {
  345.     sprintf(buf,"Nodes:       %d\n",nnodes);  stdputstr(buf);
  346.     sprintf(buf,"Free nodes:  %d\n",nfree);   stdputstr(buf);
  347.     sprintf(buf,"Segments:    %d\n",nsegs);   stdputstr(buf);
  348.     sprintf(buf,"Allocate:    %d\n",anodes);  stdputstr(buf);
  349.     sprintf(buf,"Total:       %ld\n",total);  stdputstr(buf);
  350.     sprintf(buf,"Collections: %d\n",gccalls); stdputstr(buf);
  351. }
  352.  
  353. /* xlminit - initialize the dynamic memory module */
  354. xlminit()
  355. {
  356.     /* initialize our internal variables */
  357.     anodes = NNODES;
  358.     total = 0L;
  359.     nnodes = nsegs = nfree = gccalls = 0;
  360.     fnodes = NIL;
  361.     segs = NULL;
  362.  
  363.     /* initialize structures that are marked by the collector */
  364.     xlstack = xlenv = oblist = keylist = NIL;
  365. }
  366.